home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / doop.c < prev    next >
C/C++ Source or Header  |  1998-07-19  |  11KB  |  529 lines
  1. /*    doop.c
  2.  *
  3.  *    Copyright (c) 1991-1997, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "'So that was the job I felt I had to do when I started,' thought Sam."
  12.  */
  13.  
  14. #include "EXTERN.h"
  15. #include "perl.h"
  16.  
  17. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  18. #include <signal.h>
  19. #endif
  20.  
  21. I32
  22. do_trans(SV *sv, OP *arg)
  23. {
  24.     dTHR;
  25.     register short *tbl;
  26.     register U8 *s;
  27.     register U8 *send;
  28.     register U8 *d;
  29.     register I32 ch;
  30.     register I32 matches = 0;
  31.     register I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
  32.     register U8 *p;
  33.     STRLEN len;
  34.  
  35.     if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_COUNTONLY))
  36.     croak(no_modify);
  37.     tbl = (short*)cPVOP->op_pv;
  38.     s = (U8*)SvPV(sv, len);
  39.     if (!len)
  40.     return 0;
  41.     if (!SvPOKp(sv))
  42.     s = (U8*)SvPV_force(sv, len);
  43.     (void)SvPOK_only(sv);
  44.     send = s + len;
  45.     if (!tbl || !s)
  46.     croak("panic: do_trans");
  47.     DEBUG_t( deb("2.TBL\n"));
  48.     if (!PL_op->op_private) {
  49.     while (s < send) {
  50.         if ((ch = tbl[*s]) >= 0) {
  51.         matches++;
  52.         *s = ch;
  53.         }
  54.         s++;
  55.     }
  56.     SvSETMAGIC(sv);
  57.     }
  58.     else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
  59.     while (s < send) {
  60.         if (tbl[*s] >= 0)
  61.         matches++;
  62.         s++;
  63.     }
  64.     }
  65.     else {
  66.     d = s;
  67.     p = send;
  68.     while (s < send) {
  69.         if ((ch = tbl[*s]) >= 0) {
  70.         *d = ch;
  71.         matches++;
  72.         if (squash) {
  73.             if (p == d - 1 && *p == *d)
  74.             matches--;
  75.             else
  76.                 p = d++;
  77.         }
  78.         else
  79.             d++;
  80.         }
  81.         else if (ch == -1)        /* -1 is unmapped character */
  82.         *d++ = *s;        /* -2 is delete character */
  83.         s++;
  84.     }
  85.     matches += send - d;    /* account for disappeared chars */
  86.     *d = '\0';
  87.     SvCUR_set(sv, d - (U8*)SvPVX(sv));
  88.     SvSETMAGIC(sv);
  89.     }
  90.     return matches;
  91. }
  92.  
  93. void
  94. do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
  95. {
  96.     SV **oldmark = mark;
  97.     register I32 items = sp - mark;
  98.     register STRLEN len;
  99.     STRLEN delimlen;
  100.     register char *delim = SvPV(del, delimlen);
  101.     STRLEN tmplen;
  102.  
  103.     mark++;
  104.     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
  105.     if (SvTYPE(sv) < SVt_PV)
  106.     sv_upgrade(sv, SVt_PV);
  107.     if (SvLEN(sv) < len + items) {    /* current length is way too short */
  108.     while (items-- > 0) {
  109.         if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
  110.         SvPV(*mark, tmplen);
  111.         len += tmplen;
  112.         }
  113.         mark++;
  114.     }
  115.     SvGROW(sv, len + 1);        /* so try to pre-extend */
  116.  
  117.     mark = oldmark;
  118.     items = sp - mark;;
  119.     ++mark;
  120.     }
  121.  
  122.     if (items-- > 0) {
  123.     char *s;
  124.  
  125.     if (*mark) {
  126.         s = SvPV(*mark, tmplen);
  127.         sv_setpvn(sv, s, tmplen);
  128.     }
  129.     else
  130.         sv_setpv(sv, "");
  131.     mark++;
  132.     }
  133.     else
  134.     sv_setpv(sv,"");
  135.     len = delimlen;
  136.     if (len) {
  137.     for (; items > 0; items--,mark++) {
  138.         sv_catpvn(sv,delim,len);
  139.         sv_catsv(sv,*mark);
  140.     }
  141.     }
  142.     else {
  143.     for (; items > 0; items--,mark++)
  144.         sv_catsv(sv,*mark);
  145.     }
  146.     SvSETMAGIC(sv);
  147. }
  148.  
  149. void
  150. do_sprintf(SV *sv, I32 len, SV **sarg)
  151. {
  152.     STRLEN patlen;
  153.     char *pat = SvPV(*sarg, patlen);
  154.     bool do_taint = FALSE;
  155.  
  156.     sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
  157.     SvSETMAGIC(sv);
  158.     if (do_taint)
  159.     SvTAINTED_on(sv);
  160. }
  161.  
  162. void
  163. do_vecset(SV *sv)
  164. {
  165.     SV *targ = LvTARG(sv);
  166.     register I32 offset;
  167.     register I32 size;
  168.     register unsigned char *s;
  169.     register unsigned long lval;
  170.     I32 mask;
  171.     STRLEN targlen;
  172.     STRLEN len;
  173.  
  174.     if (!targ)
  175.     return;
  176.     s = (unsigned char*)SvPV_force(targ, targlen);
  177.     lval = U_L(SvNV(sv));
  178.     offset = LvTARGOFF(sv);
  179.     size = LvTARGLEN(sv);
  180.     
  181.     len = (offset + size + 7) / 8;
  182.     if (len > targlen) {
  183.     s = (unsigned char*)SvGROW(targ, len + 1);
  184.     (void)memzero(s + targlen, len - targlen + 1);
  185.     SvCUR_set(targ, len);
  186.     }
  187.     
  188.     if (size < 8) {
  189.     mask = (1 << size) - 1;
  190.     size = offset & 7;
  191.     lval &= mask;
  192.     offset >>= 3;
  193.     s[offset] &= ~(mask << size);
  194.     s[offset] |= lval << size;
  195.     }
  196.     else {
  197.     offset >>= 3;
  198.     if (size == 8)
  199.         s[offset] = lval & 255;
  200.     else if (size == 16) {
  201.         s[offset] = (lval >> 8) & 255;
  202.         s[offset+1] = lval & 255;
  203.     }
  204.     else if (size == 32) {
  205.         s[offset] = (lval >> 24) & 255;
  206.         s[offset+1] = (lval >> 16) & 255;
  207.         s[offset+2] = (lval >> 8) & 255;
  208.         s[offset+3] = lval & 255;
  209.     }
  210.     }
  211. }
  212.  
  213. void
  214. do_chop(register SV *astr, register SV *sv)
  215. {
  216.     STRLEN len;
  217.     char *s;
  218.     
  219.     if (SvTYPE(sv) == SVt_PVAV) {
  220.     register I32 i;
  221.         I32 max;
  222.     AV* av = (AV*)sv;
  223.         max = AvFILL(av);
  224.         for (i = 0; i <= max; i++) {
  225.         sv = (SV*)av_fetch(av, i, FALSE);
  226.         if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
  227.         do_chop(astr, sv);
  228.     }
  229.         return;
  230.     }
  231.     if (SvTYPE(sv) == SVt_PVHV) {
  232.         HV* hv = (HV*)sv;
  233.     HE* entry;
  234.         (void)hv_iterinit(hv);
  235.         /*SUPPRESS 560*/
  236.         while (entry = hv_iternext(hv))
  237.             do_chop(astr,hv_iterval(hv,entry));
  238.         return;
  239.     }
  240.     s = SvPV(sv, len);
  241.     if (len && !SvPOK(sv))
  242.     s = SvPV_force(sv, len);
  243.     if (s && len) {
  244.     s += --len;
  245.     sv_setpvn(astr, s, 1);
  246.     *s = '\0';
  247.     SvCUR_set(sv, len);
  248.     SvNIOK_off(sv);
  249.     }
  250.     else
  251.     sv_setpvn(astr, "", 0);
  252.     SvSETMAGIC(sv);
  253. } 
  254.  
  255. I32
  256. do_chomp(register SV *sv)
  257. {
  258.     dTHR;
  259.     register I32 count;
  260.     STRLEN len;
  261.     char *s;
  262.  
  263.     if (RsSNARF(PL_rs))
  264.     return 0;
  265.     count = 0;
  266.     if (SvTYPE(sv) == SVt_PVAV) {
  267.     register I32 i;
  268.         I32 max;
  269.     AV* av = (AV*)sv;
  270.         max = AvFILL(av);
  271.         for (i = 0; i <= max; i++) {
  272.         sv = (SV*)av_fetch(av, i, FALSE);
  273.         if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
  274.         count += do_chomp(sv);
  275.     }
  276.         return count;
  277.     }
  278.     if (SvTYPE(sv) == SVt_PVHV) {
  279.         HV* hv = (HV*)sv;
  280.     HE* entry;
  281.         (void)hv_iterinit(hv);
  282.         /*SUPPRESS 560*/
  283.         while (entry = hv_iternext(hv))
  284.             count += do_chomp(hv_iterval(hv,entry));
  285.         return count;
  286.     }
  287.     s = SvPV(sv, len);
  288.     if (len && !SvPOKp(sv))
  289.     s = SvPV_force(sv, len);
  290.     if (s && len) {
  291.     s += --len;
  292.     if (RsPARA(PL_rs)) {
  293.         if (*s != '\n')
  294.         goto nope;
  295.         ++count;
  296.         while (len && s[-1] == '\n') {
  297.         --len;
  298.         --s;
  299.         ++count;
  300.         }
  301.     }
  302.     else {
  303.         STRLEN rslen;
  304.         char *rsptr = SvPV(PL_rs, rslen);
  305.         if (rslen == 1) {
  306.         if (*s != *rsptr)
  307.             goto nope;
  308.         ++count;
  309.         }
  310.         else {
  311.         if (len < rslen - 1)
  312.             goto nope;
  313.         len -= rslen - 1;
  314.         s -= rslen - 1;
  315.         if (memNE(s, rsptr, rslen))
  316.             goto nope;
  317.         count += rslen;
  318.         }
  319.     }
  320.     *s = '\0';
  321.     SvCUR_set(sv, len);
  322.     SvNIOK_off(sv);
  323.     }
  324.   nope:
  325.     SvSETMAGIC(sv);
  326.     return count;
  327. } 
  328.  
  329. void
  330. do_vop(I32 optype, SV *sv, SV *left, SV *right)
  331. {
  332.     dTHR;    /* just for taint */
  333. #ifdef LIBERAL
  334.     register long *dl;
  335.     register long *ll;
  336.     register long *rl;
  337. #endif
  338.     register char *dc;
  339.     STRLEN leftlen;
  340.     STRLEN rightlen;
  341.     register char *lc;
  342.     register char *rc;
  343.     register I32 len;
  344.     I32 lensave;
  345.     char *lsave;
  346.     char *rsave;
  347.  
  348.     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
  349.     sv_setpvn(sv, "", 0);    /* avoid undef warning on |= and ^= */
  350.     lsave = lc = SvPV(left, leftlen);
  351.     rsave = rc = SvPV(right, rightlen);
  352.     len = leftlen < rightlen ? leftlen : rightlen;
  353.     lensave = len;
  354.     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
  355.     dc = SvPV_force(sv, PL_na);
  356.     if (SvCUR(sv) < len) {
  357.         dc = SvGROW(sv, len + 1);
  358.         (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
  359.     }
  360.     }
  361.     else {
  362.     I32 needlen = ((optype == OP_BIT_AND)
  363.             ? len : (leftlen > rightlen ? leftlen : rightlen));
  364.     Newz(801, dc, needlen + 1, char);
  365.     (void)sv_usepvn(sv, dc, needlen);
  366.     dc = SvPVX(sv);        /* sv_usepvn() calls Renew() */
  367.     }
  368.     SvCUR_set(sv, len);
  369.     (void)SvPOK_only(sv);
  370. #ifdef LIBERAL
  371.     if (len >= sizeof(long)*4 &&
  372.     !((long)dc % sizeof(long)) &&
  373.     !((long)lc % sizeof(long)) &&
  374.     !((long)rc % sizeof(long)))    /* It's almost always aligned... */
  375.     {
  376.     I32 remainder = len % (sizeof(long)*4);
  377.     len /= (sizeof(long)*4);
  378.  
  379.     dl = (long*)dc;
  380.     ll = (long*)lc;
  381.     rl = (long*)rc;
  382.  
  383.     switch (optype) {
  384.     case OP_BIT_AND:
  385.         while (len--) {
  386.         *dl++ = *ll++ & *rl++;
  387.         *dl++ = *ll++ & *rl++;
  388.         *dl++ = *ll++ & *rl++;
  389.         *dl++ = *ll++ & *rl++;
  390.         }
  391.         break;
  392.     case OP_BIT_XOR:
  393.         while (len--) {
  394.         *dl++ = *ll++ ^ *rl++;
  395.         *dl++ = *ll++ ^ *rl++;
  396.         *dl++ = *ll++ ^ *rl++;
  397.         *dl++ = *ll++ ^ *rl++;
  398.         }
  399.         break;
  400.     case OP_BIT_OR:
  401.         while (len--) {
  402.         *dl++ = *ll++ | *rl++;
  403.         *dl++ = *ll++ | *rl++;
  404.         *dl++ = *ll++ | *rl++;
  405.         *dl++ = *ll++ | *rl++;
  406.         }
  407.     }
  408.  
  409.     dc = (char*)dl;
  410.     lc = (char*)ll;
  411.     rc = (char*)rl;
  412.  
  413.     len = remainder;
  414.     }
  415. #endif
  416.     {
  417.     switch (optype) {
  418.     case OP_BIT_AND:
  419.         while (len--)
  420.         *dc++ = *lc++ & *rc++;
  421.         break;
  422.     case OP_BIT_XOR:
  423.         while (len--)
  424.         *dc++ = *lc++ ^ *rc++;
  425.         goto mop_up;
  426.     case OP_BIT_OR:
  427.         while (len--)
  428.         *dc++ = *lc++ | *rc++;
  429.       mop_up:
  430.         len = lensave;
  431.         if (rightlen > len)
  432.         sv_catpvn(sv, rsave + len, rightlen - len);
  433.         else if (leftlen > len)
  434.         sv_catpvn(sv, lsave + len, leftlen - len);
  435.         else
  436.         *SvEND(sv) = '\0';
  437.         break;
  438.     }
  439.     }
  440.     SvTAINT(sv);
  441. }
  442.  
  443. OP *
  444. do_kv(ARGSproto)
  445. {
  446.     djSP;
  447.     HV *hv = (HV*)POPs;
  448.     HV *keys;
  449.     register HE *entry;
  450.     SV *tmpstr;
  451.     I32 gimme = GIMME_V;
  452.     I32 dokeys =   (PL_op->op_type == OP_KEYS);
  453.     I32 dovalues = (PL_op->op_type == OP_VALUES);
  454.     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
  455.     
  456.     if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) 
  457.     dokeys = dovalues = TRUE;
  458.  
  459.     if (!hv) {
  460.     if (PL_op->op_flags & OPf_MOD) {    /* lvalue */
  461.         dTARGET;        /* make sure to clear its target here */
  462.         if (SvTYPE(TARG) == SVt_PVLV)
  463.         LvTARG(TARG) = Nullsv;
  464.         PUSHs(TARG);
  465.     }
  466.     RETURN;
  467.     }
  468.  
  469.     keys = realhv ? hv : avhv_keys((AV*)hv);
  470.     (void)hv_iterinit(keys);    /* always reset iterator regardless */
  471.  
  472.     if (gimme == G_VOID)
  473.     RETURN;
  474.  
  475.     if (gimme == G_SCALAR) {
  476.     IV i;
  477.     dTARGET;
  478.  
  479.     if (PL_op->op_flags & OPf_MOD) {    /* lvalue */
  480.         if (SvTYPE(TARG) < SVt_PVLV) {
  481.         sv_upgrade(TARG, SVt_PVLV);
  482.         sv_magic(TARG, Nullsv, 'k', Nullch, 0);
  483.         }
  484.         LvTYPE(TARG) = 'k';
  485.         if (LvTARG(TARG) != (SV*)keys) {
  486.         if (LvTARG(TARG))
  487.             SvREFCNT_dec(LvTARG(TARG));
  488.         LvTARG(TARG) = SvREFCNT_inc(keys);
  489.         }
  490.         PUSHs(TARG);
  491.         RETURN;
  492.     }
  493.  
  494.     if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
  495.         i = HvKEYS(keys);
  496.     else {
  497.         i = 0;
  498.         /*SUPPRESS 560*/
  499.         while (hv_iternext(keys)) i++;
  500.     }
  501.     PUSHi( i );
  502.     RETURN;
  503.     }
  504.  
  505.     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
  506.  
  507.     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
  508.     while (entry = hv_iternext(keys)) {
  509.     SPAGAIN;
  510.     if (dokeys)
  511.         XPUSHs(hv_iterkeysv(entry));    /* won't clobber stack_sp */
  512.     if (dovalues) {
  513.         tmpstr = sv_newmortal();
  514.         PUTBACK;
  515.         sv_setsv(tmpstr,realhv ?
  516.              hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
  517.         DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
  518.                 (unsigned long)HeHASH(entry),
  519.                 HvMAX(keys)+1,
  520.                 (unsigned long)(HeHASH(entry) & HvMAX(keys))));
  521.         SPAGAIN;
  522.         XPUSHs(tmpstr);
  523.     }
  524.     PUTBACK;
  525.     }
  526.     return NORMAL;
  527. }
  528.  
  529.